home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / major_gc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  8.3 KB  |  303 lines  |  [TEXT/MPS ]
  1. #include "config.h"
  2. #include "debugger.h"
  3. #include "fail.h"
  4. #include "freelist.h"
  5. #include "gc.h"
  6. #include "globals.h"
  7. #include "major_gc.h"
  8. #include "misc.h"
  9. #include "mlvalues.h"
  10. #include "roots.h"
  11.  
  12. #ifdef macintosh
  13. #include <Memory.h>
  14. #endif
  15. #ifdef __TURBOC__
  16. #include <alloc.h>
  17. #endif
  18.  
  19. char *heap_start, *heap_end;
  20. unsigned long total_heap_size;
  21. char *page_table;
  22. asize_t page_table_size;
  23. unsigned free_mem_percent_min, free_mem_percent_max;
  24. free_list_t master_fl;
  25. char *gc_sweep_hp;
  26. int gc_phase;
  27. static value *gray_vals;
  28. value *gray_vals_cur, *gray_vals_end;
  29. static asize_t gray_vals_size;
  30. static int heap_is_pure;   /* The heap is pure if the only gray objects
  31.                               below [markhp] are also in [gray_vals]. */
  32. unsigned long allocated_words;
  33.  
  34. static char *markhp, *chunk, *limit;
  35.  
  36. static void realloc_gray_vals ()
  37. {
  38.   value *new;
  39.  
  40.   Assert (gray_vals_cur == gray_vals_end);
  41.   if (gray_vals_size < Gray_vals_max){
  42.     gc_message ("Growing gray_vals to %ld kB.\n",
  43.         (long) gray_vals_size * sizeof (value) / 512);
  44.     new = (value *) realloc ((char *) gray_vals,
  45.                              2 * gray_vals_size * sizeof (value));
  46.     if (new == NULL){
  47.       gc_message ("No room.\n", 0);
  48.       gray_vals_cur = gray_vals;
  49.       heap_is_pure = 0;
  50.     }else{
  51.       gray_vals = new;
  52.       gray_vals_cur = gray_vals + gray_vals_size;
  53.       gray_vals_size *= 2;
  54.       gray_vals_end = gray_vals + gray_vals_size;
  55.     }
  56.   }else{
  57.     gray_vals_cur = gray_vals + gray_vals_size / 2;
  58.     heap_is_pure = 0;
  59.   }
  60. }
  61.  
  62. void darken (v)
  63.      value v;
  64. {
  65.   if (Is_block (v) && Is_in_heap (v) && Is_white_val (v)){
  66.     Hd_val (v) = Grayhd_hd (Hd_val (v));
  67.     *gray_vals_cur++ = v;
  68.     if (gray_vals_cur >= gray_vals_end) realloc_gray_vals ();
  69.   }
  70. }
  71.  
  72. static void darken_root (p, v)
  73.      value *p;
  74.      value v;
  75. {
  76.   darken (v);
  77. }
  78.  
  79. static void start_cycle ()
  80. {
  81.   Assert (gray_vals_cur == gray_vals);
  82.   Assert (Is_white_val (global_data));
  83.   darken (global_data);
  84.   local_roots (darken_root);
  85.   gc_phase = Phase_mark;
  86.   markhp = NULL;
  87. }
  88.  
  89. static void mark_slice (work)
  90.      long work;
  91. {
  92.   value v, child;
  93.   mlsize_t i;
  94.  
  95.   while (work > 0){
  96.     if (gray_vals_cur > gray_vals){
  97.       v = *--gray_vals_cur;
  98.       Assert (Is_gray_val (v));
  99.       Hd_val (v) = Blackhd_hd (Hd_val (v));
  100.       if (Tag_val (v) < No_scan_tag){
  101.     for (i = Wosize_val (v); i > 0;){
  102.       --i;
  103.       child = Field (v, i);
  104.       darken (child);
  105.     }
  106.       }
  107.       work -= Whsize_val (v);
  108.     }else if (markhp != NULL){
  109.       if (markhp == limit){
  110.     chunk = (((heap_chunk_head *) chunk) [-1]).next;
  111.     if (chunk == NULL){
  112.       markhp = NULL;
  113.     }else{
  114.       markhp = chunk;
  115.       limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  116.     }
  117.       }else{
  118.     if (Is_gray_val (Val_hp (markhp))){
  119.       Assert (gray_vals_cur == gray_vals);
  120.       *gray_vals_cur++ = Val_hp (markhp);
  121.     }
  122.     markhp += Bhsize_hp (markhp);
  123.       }
  124.     }else if (!heap_is_pure){
  125.       heap_is_pure = 1;
  126.       chunk = heap_start;
  127.       markhp = chunk;
  128.       limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  129.     }else{
  130.       /* Marking is done. */
  131.       gc_sweep_hp = heap_start;
  132.       gc_phase = Phase_sweep;
  133.       chunk = heap_start;
  134.       gc_sweep_hp = chunk;
  135.       limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  136.       work = 0;
  137.     }
  138.   }
  139. }
  140.  
  141. static void sweep_slice (work)
  142.      long work;
  143. {
  144.   char *hp;
  145.  
  146.   while (work > 0){
  147.     if (gc_sweep_hp < limit){
  148.       hp = gc_sweep_hp;
  149.       /* [fl_add_block] might erase the header, so we must read it now. */
  150.       work -= Whsize_hp (hp);
  151.       gc_sweep_hp += Bhsize_hp (hp);
  152.       switch (Color_hp (hp)){
  153.       case White:
  154.     if (Tag_hp (hp) == Final_tag){
  155.       Final_fun (Val_hp (hp)) (Val_hp (hp));
  156.     }
  157.     fl_add_block (master_fl, Bp_hp (hp));
  158.     break;
  159.       case Gray:
  160.     Assert (0);
  161.       case Black:
  162.     Hd_hp (hp) = Whitehd_hd (Hd_hp (hp));
  163.     break;
  164.       case Blue:
  165.     break;
  166.       }
  167.       Assert (gc_sweep_hp <= limit);
  168.     }else{
  169.       chunk = (((heap_chunk_head *) chunk) [-1]).next;
  170.       if (chunk == NULL){
  171.     /* Sweeping is done.  Start the next cycle. */
  172.     work = 0;
  173.     start_cycle ();
  174.       }else{
  175.     gc_sweep_hp = chunk;
  176.     limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  177.       }
  178.     }
  179.   }
  180. }
  181.  
  182. void major_collection_slice ()
  183. {
  184.   /* Free memory at the start of the GC cycle :
  185.                  FM =  total_heap_size * free_mem_percent / 100
  186.      Proportion of free memory consumed since the previous minor GC :
  187.                  P = allocated_words / FM
  188.      Amount of marking work for the GC cycle :
  189.                  MW = total_heap_size * (100 - free_mem_percent) / 100
  190.      Amount of sweeping work for the GC cycle :
  191.                  SW = total_heap_size
  192.      Amount of marking work for this slice :
  193.                  MS = MW * 2 * P
  194.                  MS = 2 * (100 - free_mem_percent) * allocated_words
  195.                       / free_mem_percent
  196.      Amount of sweeping work for this slice :
  197.                  SS = SW * 2 * P
  198.                  SS = 2 * 100 * allocated_words / free_mem_percent
  199.      This slice will either mark MS words or sweep SS words.
  200.   */
  201.   int free_mem_percent;
  202.  
  203. #ifdef SMALL
  204.   long available_memory = 2000000000; /* just in case */
  205. #ifdef macintosh
  206.   available_memory = FreeMem() - 49152;
  207. #endif
  208. #ifdef __TURBOC__
  209.   available_memory = coreleft() - 49152;
  210. #endif
  211.   free_mem_percent = (Bsize_wsize (master_fl->total_wosize) + available_memory)
  212.                      * 100 / (total_heap_size + available_memory);
  213.   if (free_mem_percent > free_mem_percent_max)
  214.     free_mem_percent = free_mem_percent_max;
  215.   if (free_mem_percent < free_mem_percent_min)
  216.     free_mem_percent = free_mem_percent_min;
  217. #else
  218.   free_mem_percent = free_mem_percent_max;
  219. #endif
  220.   if (gc_phase == Phase_mark){
  221.     mark_slice (2 * (100 - free_mem_percent) * allocated_words
  222.         / free_mem_percent + 100);
  223.     gc_message ("!", 0);
  224.   }else{
  225.     Assert (gc_phase == Phase_sweep);
  226.     sweep_slice (200 * allocated_words / free_mem_percent + 100);
  227.     gc_message ("$", 0);
  228.   }
  229.   allocated_words = 0;
  230. }
  231.  
  232. unsigned long major_collection ()
  233. {
  234.   if (gc_phase == Phase_mark) mark_slice (2000000000);
  235.   Assert (gc_phase == Phase_sweep);
  236.   sweep_slice (2000000000);
  237.   allocated_words = 0;
  238.   return Bsize_wsize (master_fl->total_wosize);
  239. }
  240.  
  241. asize_t round_heap_chunk_size (request)
  242.      asize_t request;
  243. {
  244.   if (request < Heap_chunk_min){
  245.     Assert (Heap_chunk_min % Page_size == 0);
  246.     return Heap_chunk_min;
  247.   }else if (request <= Heap_chunk_max){
  248.     return ((request + Page_size - 1) >> Page_log) << Page_log;
  249.   }else{
  250.     raise_out_of_memory ();
  251.   }
  252. }
  253.  
  254. void init_major_heap (heap_size)
  255.      asize_t heap_size;
  256. {
  257.   asize_t i;
  258.  
  259.   master_fl = fl_new ();
  260.   total_heap_size = round_heap_chunk_size (heap_size);
  261.   Assert (total_heap_size % Page_size == 0);
  262.   gc_message ("Initial heap size: %ld kB.\n", total_heap_size / 1024);
  263.   heap_start = aligned_malloc (total_heap_size + sizeof (heap_chunk_head),
  264.                    sizeof (heap_chunk_head));
  265.   if (heap_start == NULL)
  266.     fatal_unix_error ("cannot allocate the initial heap", "");
  267.   heap_start += sizeof (heap_chunk_head);
  268.   Assert ((unsigned long) heap_start % Page_size == 0);
  269.   (((heap_chunk_head *) heap_start) [-1]).size = total_heap_size;
  270.   (((heap_chunk_head *) heap_start) [-1]).next = NULL;
  271.   heap_end = heap_start + total_heap_size;
  272.   Assert ((unsigned long) heap_end % Page_size == 0);
  273. #ifndef SIXTEEN
  274.   page_table_size = 4 * total_heap_size / Page_size;
  275. #else
  276.   page_table_size = 640L * 1024L / Page_size + 1;
  277. #endif
  278.   page_table = (char *) malloc (page_table_size);
  279.   if (page_table == NULL)
  280.     fatal_unix_error ("cannot allocate the initial heap", "");
  281.   for (i = 0; i < page_table_size; i++) {
  282.     page_table [i] = Not_in_heap;
  283.   }
  284.   for (i = Page(heap_start); i < Page (heap_end); i++) {
  285.     page_table[i] = In_heap;
  286.   }
  287.   Hd_hp (heap_start) = Make_header (Wosize_bhsize (total_heap_size), 0, Blue);
  288.   fl_add_block (master_fl, Bp_hp (heap_start));
  289.   /* We start the major GC in the marking phase, just after the roots have been
  290.      darkened. (Since there are no roots, we don't have to darken anything.) */
  291.   gc_phase = Phase_mark;
  292.   gray_vals_size = 2048;
  293.   gray_vals = (value *) malloc (gray_vals_size * sizeof (value));
  294.   gray_vals_cur = gray_vals;
  295.   gray_vals_end = gray_vals + gray_vals_size;
  296.   heap_is_pure = 1;
  297.   if (free_mem_percent_min < 1) free_mem_percent_min = 1;
  298.   if (free_mem_percent_max > 99) free_mem_percent_max = 99;
  299.   if (free_mem_percent_max < free_mem_percent_min)
  300.     free_mem_percent_max = free_mem_percent_min;
  301.   allocated_words = 0;
  302. }
  303.